home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / w3-menu.el.z / w3-menu.el
Encoding:
Text File  |  1998-05-21  |  24.4 KB  |  764 lines
  1. ;;; w3-menu.el --- Menu functions for emacs-w3
  2. ;; Author: wmperry
  3. ;; Created: 1998/01/07 03:56:10
  4. ;; Version: 1.46
  5. ;; Keywords: menu, hypermedia
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1996 by William M. Perry <wmperry@cs.indiana.edu>
  9. ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
  10. ;;;
  11. ;;; This file is part of GNU Emacs.
  12. ;;;
  13. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  14. ;;; it under the terms of the GNU General Public License as published by
  15. ;;; the Free Software Foundation; either version 2, or (at your option)
  16. ;;; any later version.
  17. ;;;
  18. ;;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ;;; GNU General Public License for more details.
  22. ;;;
  23. ;;; You should have received a copy of the GNU General Public License
  24. ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;;; Boston, MA 02111-1307, USA.
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28.  
  29. (require 'w3-vars)
  30. (require 'w3-mouse)
  31. (require 'widget)
  32. (require 'w3-keyword)
  33.  
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35. ;;; InfoDock stuff
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37. (if (fboundp 'id-menubar-set)
  38.     (id-menubar-set 'w3-mode 'w3-menu-make-xemacs-menubar))
  39.  
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41. ;;; Spiffy new menus (for both Emacs and XEmacs)
  42. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43. (defvar w3-menu-fsfemacs-bookmark-menu nil)
  44. (defvar w3-menu-fsfemacs-debug-menu nil)
  45. (defvar w3-menu-fsfemacs-edit-menu nil)
  46. (defvar w3-menu-fsfemacs-file-menu nil)
  47. (defvar w3-menu-fsfemacs-go-menu nil)
  48. (defvar w3-menu-fsfemacs-help-menu nil)
  49. (defvar w3-menu-fsfemacs-view-menu nil)
  50. (defvar w3-menu-fsfemacs-options-menu nil)
  51. (defvar w3-menu-fsfemacs-style-menu nil)
  52. (defvar w3-menu-fsfemacs-search-menu nil)
  53. (defvar w3-menu-w3-menubar nil)
  54. (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.")
  55. (make-variable-buffer-local 'w3-links-menu)
  56.  
  57. (defcustom w3-use-menus '(file edit view go bookmark options buffers style
  58.                    emacs nil help)
  59.   "*Non-nil value causes W3 to provide a menu interface.
  60. A value that is a list causes W3 to install its own menubar.
  61. A value of 1 causes W3 to install a \"W3\" item in the Emacs menubar.
  62.  
  63. If the value of w3-use-menus is a list, it should be a list of symbols.
  64. The symbols and the order that they are listed determine what menus
  65. will be in the menubar and how they are ordered.  Valid symbol values
  66. are:
  67.  
  68. file        -- A list of file related commands
  69. edit        -- Various standard editing commands (copy/paste)
  70. view        -- Controlling various things about the document view
  71. go        -- Navigation control
  72. bookmark    -- Bookmark / hotlist control
  73. options        -- Various options
  74. buffers        -- The standard buffers menu
  75. emacs        -- A toggle button to switch back to normal emacs menus
  76. style        -- Control style information and who gets to set what
  77. search          -- Various search engines
  78. help        -- The help menu
  79. nil        -- ** special **
  80.  
  81. If nil appears in the list, it should appear exactly once.  All
  82. menus after nil in the list will be displayed flushright in the
  83. menubar.
  84.  
  85. NOTE!  The current port of Emacs to Windows NT/95 does not support
  86. buttons in the menubar, so the 'emacs' keyword is currently ignored
  87. on that platform."
  88.   :group 'w3-menus
  89.   :type '(set (const :tag "File related commands" :value file)
  90.           (const :tag "Standard editing commands" :value edit)
  91.           (const :tag "View document information" :value view)
  92.           (const :tag "Navigation" :value go)
  93.           (const :tag "Bookmarks" :value bookmark)
  94.           (const :tag "Options" :value options)
  95.           (const :tag "Buffer list" :value buffers)
  96.           (const :tag "Stylesheet information" :value style)
  97.           (const :tag "Search engines" :value search)
  98.           (const :tag "Toggle to default menus" :value emacs)
  99.           (const :tag "Separator" :value nil)
  100.           (const :tag "Help" :value help)))
  101.  
  102. (defun w3-menu-hotlist-constructor (menu-items)
  103.   (or (cdr w3-html-bookmarks)
  104.       (let ((hot-menu nil)
  105.         (hot w3-hotlist))
  106.     (while hot
  107.       (setq hot-menu (cons (vector
  108.                 (w3-truncate-menu-item (car (car hot)))
  109.                 (list 'w3-fetch (car (cdr (car hot))))
  110.                 t) hot-menu)
  111.         hot (cdr hot)))
  112.     (or hot-menu '(["No Hotlist" nil nil])))))
  113.  
  114. (defun w3-menu-html-links-constructor (menu-items)
  115.   (or menu-items
  116.       (let ((links (mapcar 'cdr w3-current-links))
  117.         (menu nil))
  118.     (if links
  119.         (setq links (delete*
  120.              nil
  121.              (reduce 'append links)
  122.              :test-not (function
  123.                     (lambda (a b) ; arg order unknown
  124.                       (member
  125.                        (car (or a b))
  126.                        w3-defined-link-types))))))
  127.     (while links
  128.       (let ((name (caar links))
  129.         (vals (cdar links))
  130.         (href nil)
  131.         (new nil))
  132.         (if (= (length vals) 1)
  133.         (setq vals (car vals)
  134.               new (vector (or (plist-get vals 'title)
  135.                       (capitalize name))
  136.                   (list 'w3-fetch (plist-get vals 'href)) t))
  137.           (setq new (cons (capitalize name)
  138.                   (mapcar (function
  139.                        (lambda (x)
  140.                      (setq href (plist-get x 'href))
  141.                      (vector (or (plist-get x 'title) href)
  142.                          (list 'w3-fetch href) t)))
  143.                       vals))))
  144.         (setq links (cdr links)
  145.           menu (cons new menu))))
  146.     (or menu '(["None" nil nil])))))
  147.  
  148. (defun w3-menu-links-constructor (menu-items)
  149.   (or menu-items
  150.       (let ((widgets (w3-only-links))
  151.         widget href menu)
  152.     (while widgets
  153.       (setq widget (car widgets)
  154.         widgets (cdr widgets)
  155.         href (widget-get widget :href)
  156.         menu (cons
  157.               (vector (w3-truncate-menu-item
  158.                    (or (widget-get widget :title)
  159.                    (w3-fix-spaces
  160.                     (buffer-substring
  161.                      (widget-get widget :from)
  162.                      (widget-get widget :to)))))
  163.                   (list 'url-maybe-relative href) t) menu)))
  164.     (setq menu (w3-breakup-menu menu w3-max-menu-length))
  165.     (or menu '(["No Links" nil nil])))))
  166.  
  167. (defun w3-toggle-minibuffer ()
  168.   (interactive)
  169.   (cond
  170.    (w3-running-xemacs
  171.     (if (equal (frame-property (selected-frame) 'minibuffer) t)
  172.  
  173.     ;; frame has a minibuffer, so remove it
  174.     ;; unfortunately, we must delete and redraw the frame
  175.     (let ((fp (frame-properties (selected-frame)))
  176.           (frame (selected-frame))
  177.           (buf (current-buffer)))
  178.       (select-frame
  179.        (make-frame (plist-put
  180.             (plist-remprop
  181.              (plist-remprop fp 'window-id) 'minibuffer)
  182.             'minibuffer nil)))
  183.       (delete-frame frame)
  184.       (switch-to-buffer buf))
  185.       ;; no minibuffer so add one
  186.       (set-frame-property (selected-frame) 'minibuffer t)))
  187.    (t nil)))
  188.  
  189. (defun w3-toggle-location ()
  190.   (interactive)
  191.   (cond
  192.    (w3-running-xemacs
  193.     (let ((on (specifier-instance has-modeline-p (selected-window))))
  194.       (set-specifier has-modeline-p (not on) (selected-window))))
  195.    (t nil)))
  196.    
  197. (defun w3-toggle-menubar ()
  198.   (interactive)
  199.   (cond
  200.    ;; XEmacs style
  201.    (w3-running-xemacs
  202.     (set-specifier menubar-visible-p (cons (current-buffer)
  203.                        (not (specifier-instance
  204.                          menubar-visible-p)))))
  205.    ;; Emacs 19 style
  206.    (t
  207.     (menu-bar-mode (if (w3-menubar-active) -1 1)))))
  208.  
  209. (defun w3-location-active ()
  210.   (if w3-running-xemacs
  211.       (specifier-instance has-modeline-p (selected-window))
  212.     t))
  213.  
  214. (defun w3-menubar-active ()
  215.   (if w3-running-xemacs
  216.       (and (featurep 'menubar) (specifier-instance menubar-visible-p))
  217.     (and (boundp 'menu-bar-mode) menu-bar-mode)))
  218.  
  219. (defun w3-menu-global-menubar ()
  220.   (if w3-running-xemacs
  221.       (default-value 'default-menubar)
  222.     (lookup-key (current-global-map) [menu-bar])))
  223.  
  224. (defconst w3-menu-file-menu
  225.   (list
  226.    "File"
  227.    ["Open Location..." w3-fetch t]
  228.    ["Open File..." w3-open-local t]
  229.    ["Open in New Window..." w3-fetch-other-frame t]
  230.    ["New Window" make-frame t]
  231.    "---"
  232.    ["Save" save-buffer t nil]
  233.    (list
  234.     "Save As..."
  235.     ["HTML" (w3-save-as "HTML Source") t]
  236.     ["Formatted Text" (w3-save-as "Formatted Text") t]
  237.     ["LaTeX" (w3-save-as "LaTeX Source") t]
  238.     ["PostScript" (w3-save-as "PostScript") t]
  239.     ["Binary" (w3-save-as "Binary") t]
  240.     )
  241.    "---"
  242.    (list
  243.     "Print As..."
  244.     ["PostScript" (w3-print-this-url nil "PostScript") t]
  245.     ["Formatted Text" (w3-print-this-url nil "Formatted Text") t]
  246.     ["HTML Source" (w3-print-this-url nil "HTML Source") t]
  247.     ["LaTeX'd" (w3-print-this-url nil "LaTeX'd") t]
  248.     )
  249.    (list
  250.     "Mail Document..."
  251.     ["HTML" (w3-mail-current-document nil "HTML Source") t]
  252.     ["Formatted Text" (w3-mail-current-document nil "Formatted Text") t]
  253.     ["PostScript" (w3-mail-current-document nil "PostScript") t]
  254.     ["LaTeX Source" (w3-mail-current-document nil "LaTeX Source") t]
  255.     )
  256.    (if w3-running-xemacs
  257.        "---:shadowDoubleEtchedIn"
  258.      "---")
  259.    ["Close" delete-frame (not (eq (next-frame) (selected-frame)))]
  260.    ["Exit"  save-buffers-kill-emacs t]
  261.    )
  262.   "W3 file menu list.")
  263.  
  264. (defconst w3-menu-edit-menu
  265.   (list
  266.    "Edit"
  267.    ["Undo"            advertised-undo           nil]
  268.    ["Cut"            kill-region           nil]
  269.    ["Copy"            copy-region-as-kill       t]
  270.    "----"
  271.    ["Search..."            w3-search-forward    t]
  272.    ["Search Again..."        w3-search-again        w3-last-search-item]
  273.    "----"
  274.    (list
  275.     "Preferences"
  276.     (if (fboundp 'custom-menu-create)
  277.     (custom-menu-create 'w3)
  278.       ["W3" ignore nil])
  279.     (if (fboundp 'custom-menu-create)
  280.     (custom-menu-create 'url)
  281.       ["URL" ignore nil])
  282.     )
  283.    )
  284.   "W3 edit menu list.")
  285.  
  286. (defconst w3-menu-view-menu
  287.   (list
  288.    "View"
  289.    ["Document Information" w3-document-information t]
  290.    ["Document Source" w3-source-document t]
  291.    ["Document Errors" w3-display-errors w3-current-badhtml]
  292.    ["Load Images" w3-load-delayed-images w3-delayed-images]
  293.    "----"
  294.    ["Refresh" w3-refresh-buffer w3-current-parse]
  295.    ["Reload" w3-reload-document (and (url-view-url t)
  296.                      (not (equal (url-view-url t) "")))]
  297.    "----"
  298.    ["Show URL" url-view-url t]
  299.    ["Show URL At Point" w3-view-this-url t]
  300.    "----"
  301.    )
  302.   "W3 menu view list.")
  303.  
  304. (defconst w3-menu-debug-menu
  305.   (list
  306.    "Debugging"
  307.    ["View Parse Tree" (w3-display-parse-tree w3-current-parse)
  308.     w3-current-parse]
  309.    ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet]
  310.    ["Reload Stylesheets" w3-refresh-stylesheets t]
  311.    )
  312.   "W3 menu debug list.")
  313.  
  314. (defconst w3-menu-go-menu
  315.   (list
  316.    "Go"
  317.    ["Forward" w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t)))]
  318.    ["Back" w3-history-backward (car (w3-history-find-url-internal (url-view-url t)))]
  319.    ["Home" w3 w3-default-homepage]
  320.    ["View History..." w3-show-history-list url-keep-history]
  321.    "----"
  322.    (if w3-running-xemacs
  323.        '("Links" :filter w3-menu-links-constructor)
  324.      ["Links..." w3-e19-show-links-menu t])
  325.    (if w3-running-xemacs
  326.        '("Navigate" :filter w3-menu-html-links-constructor)
  327.      ["Navigate..." w3-e19-show-navigate-menu t])
  328.    )
  329.   "W3 menu go list.")
  330.  
  331. (defconst w3-menu-bookmark-menu
  332.   (list
  333.    "Bookmark"
  334.    ["View Bookmarks..." w3-show-hotlist w3-hotlist]
  335.    ["Add Bookmark" w3-hotlist-add-document t]
  336.    ["Delete Bookmark" w3-hotlist-delete t]
  337.    ["Rename Bookmark" w3-hotlist-rename-entry t]
  338.    ["Append Bookmark List" w3-hotlist-append t]
  339.    "----"
  340.    (if w3-running-xemacs
  341.        '("Bookmarks" :filter w3-menu-hotlist-constructor)
  342.      ["Bookmarks" w3-e19-show-hotlist-menu t])
  343.    )
  344.   "W3 menu bookmark list.")
  345.  
  346. (defconst w3-menu-options-menu
  347.   (list "Options"
  348.     ["Edit Preferences" w3-preferences-edit t]
  349.     "---"
  350.     ["Show Menubar" w3-toggle-menubar
  351.      :style toggle :selected (w3-menubar-active)]
  352.     (if (and w3-running-xemacs (featurep 'toolbar))
  353.         ["Show Toolbar" w3-toggle-toolbar
  354.          :style toggle :selected (w3-toolbar-active)]
  355.       ["Show Toolbar" w3-toggle-toolbar nil])
  356.     (if w3-running-xemacs
  357.         ["Show Location" w3-toggle-location
  358.          :style toggle :selected (w3-location-active)]
  359.       ["Show Location" w3-toggle-location nil])
  360.     (if w3-running-xemacs
  361.         ["Show Status Bar" w3-toggle-minibuffer
  362.          :style toggle
  363.          :selected (eq (frame-property (selected-frame) 'minibuffer) t)
  364.          ])
  365.     ["Incremental Display"
  366.      (setq w3-do-incremental-display (not w3-do-incremental-display))
  367.      :style toggle :selected w3-do-incremental-display]
  368.     "----"
  369.     ["Auto Load Images"
  370.      (setq w3-delay-image-loads (not w3-delay-image-loads))
  371.      :style toggle :selected (not w3-delay-image-loads)]
  372.     ["Flush Image Cache" (setq w3-graphics-list nil) w3-graphics-list]
  373.     "----"
  374.     ["Download to disk" (setq w3-dump-to-disk (not w3-dump-to-disk))
  375.      :style toggle :selected w3-dump-to-disk]
  376.     ["Caching" (setq url-automatic-caching (not url-automatic-caching))
  377.      :style toggle :selected url-automatic-caching]
  378.     ["Use Cache Only"
  379.      (setq url-standalone-mode (not url-standalone-mode))
  380.      :style toggle :selected url-standalone-mode]
  381.     "----"
  382.     ["Save Options" w3-menu-save-options t]
  383.     )
  384.   "W3 menu options list.")
  385.  
  386. (defconst w3-menu-style-menu
  387.   (list
  388.    "Style"
  389.    ["Allow Document Stylesheets" (setq w3-honor-stylesheets
  390.                        (not w3-honor-stylesheets))
  391.     :style toggle :selected w3-honor-stylesheets]
  392.    ["Honor Color Requests" (setq w3-user-colors-take-precedence
  393.                  (not w3-user-colors-take-precedence))
  394.     :style toggle :selected (not w3-user-colors-take-precedence)]
  395.    "---"
  396.    ["Reload Stylesheets" w3-refresh-stylesheets t]
  397.    )
  398.   "W3 menu style list.")
  399.  
  400. (defconst w3-menu-buffer-menu
  401.   (if w3-running-xemacs
  402.       '("Buffers"
  403.     :filter buffers-menu-filter
  404.     ["List All Buffers" list-buffers t]
  405.     "--!here")
  406.     nil)
  407.   "W3 menu buffer list.")
  408.  
  409. (defconst w3-menu-search-menu
  410.   (list
  411.    "Search"
  412.    ["Yahoo!"    (w3-fetch "http://www.yahoo.com/") t]
  413.    ["Excite"    (w3-fetch "http://www.excite.com/") t]
  414.    ["AltaVista" (w3-fetch "http://www.altavista.digital.com/") t]
  415.    ["FTP Search" (w3-fetch "http://ftpsearch.ntnu.no/home.html") t]
  416.    "---"
  417.    )
  418.   "W3 search menu")
  419.  
  420. (defconst w3-menu-emacs-button
  421.   (vector
  422.    (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t))
  423.  
  424. (defconst w3-menu-help-menu
  425.   (list
  426.    "Help"
  427.    ["About Emacs-w3" (w3-fetch "about:") t]
  428.    ["Manual" (w3-fetch (concat w3-documentation-root "docs/w3_toc.html")) t]
  429.    "---"
  430.    ["Version Information..."
  431.     (w3-fetch
  432.      (concat w3-documentation-root "help/version_" w3-version-number ".html"))
  433.     t]
  434.    ["On FAQ" (w3-fetch (concat w3-documentation-root "help/FAQ.html")) t]
  435.    "---"
  436.    ["Mail Developer(s)" w3-submit-bug t]
  437.    )
  438.   "W3 menu help list.")
  439.  
  440. (defvar w3-mode-menu-map nil)
  441.  
  442. (defun w3-menu-initialize-w3-mode-menu-map ()
  443.   (if (null w3-mode-menu-map)
  444.       (let ((map (make-sparse-keymap))
  445.         (dummy (make-sparse-keymap)))
  446.     (require 'easymenu)
  447.     ;; initialize all the w3-menu-fsfemacs-*-menu variables
  448.     ;; with the menus.
  449.     (easy-menu-define w3-menu-fsfemacs-bookmark-menu (list dummy) nil
  450.               w3-menu-bookmark-menu)
  451.     (easy-menu-define w3-menu-fsfemacs-debug-menu (list dummy) nil
  452.               w3-menu-debug-menu)
  453.     (easy-menu-define w3-menu-fsfemacs-edit-menu (list dummy) nil
  454.               w3-menu-edit-menu)
  455.     (easy-menu-define w3-menu-fsfemacs-file-menu (list dummy) nil
  456.               w3-menu-file-menu)
  457.     (easy-menu-define w3-menu-fsfemacs-go-menu (list dummy) nil
  458.               w3-menu-go-menu)
  459.     (easy-menu-define w3-menu-fsfemacs-help-menu (list dummy) nil
  460.               w3-menu-help-menu)
  461.     (easy-menu-define w3-menu-fsfemacs-view-menu (list dummy) nil
  462.               w3-menu-view-menu)
  463.     (easy-menu-define w3-menu-fsfemacs-options-menu (list dummy) nil
  464.               w3-menu-options-menu)
  465.     (easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil
  466.               w3-menu-style-menu)
  467.     (easy-menu-define w3-menu-fsfemacs-search-menu (list dummy) nil
  468.               w3-menu-search-menu)
  469.  
  470.     ;; block the global menubar entries in the map so that W3
  471.     ;; can take over the menubar if necessary.
  472.     (define-key map [rootmenu] (make-sparse-keymap))
  473.     (define-key map [rootmenu w3] (cons "W3" (make-sparse-keymap "W3")))
  474.     (define-key map [rootmenu w3 file] 'undefined)
  475.     (define-key map [rootmenu w3 files] 'undefined)
  476.     (define-key map [rootmenu w3 search] 'undefined)
  477.     (define-key map [rootmenu w3 edit] 'undefined)
  478.     (define-key map [rootmenu w3 options] 'undefined)
  479.     (define-key map [rootmenu w3 buffer] 'undefined)
  480.     (define-key map [rootmenu w3 tools] 'undefined)
  481.     (define-key map [rootmenu w3 help] 'undefined)
  482.     (define-key map [rootmenu w3 help-menu] 'undefined)
  483.     ;; now build W3's menu tree.
  484.     (let ((menu-alist
  485.            '(
  486.          (bookmark
  487.           (cons "Bookmark" w3-menu-fsfemacs-bookmark-menu))
  488.          (debug
  489.           (cons "Debug" w3-menu-fsfemacs-debug-menu))
  490.          (edit
  491.           (cons "Edit" w3-menu-fsfemacs-edit-menu))
  492.          (file
  493.           (cons "File" w3-menu-fsfemacs-file-menu))
  494.          (go
  495.           (cons "Go" w3-menu-fsfemacs-go-menu))
  496.          (help
  497.           (cons "Help" w3-menu-fsfemacs-help-menu))
  498. ;;;         (buffers
  499. ;;;          (cons "Buffers" (lookup-key global-map [menu-bar buffer])))
  500.          (options
  501.           (cons "Options" w3-menu-fsfemacs-options-menu))
  502.          (view
  503.           (cons "View" w3-menu-fsfemacs-view-menu))
  504.          (style
  505.           (cons "Style" w3-menu-fsfemacs-style-menu))
  506.          (search
  507.           (cons "Search" w3-menu-fsfemacs-search-menu))
  508.          (emacs
  509.           ;; FIXME!!! Currently, win32 doesn't support buttons
  510.           ;; in menubars, so we hack around it and ignore the
  511.           ;; 'emacs keyword on that platform.  REMOVE THIS CODE
  512.           ;; as soon as that is fixed.  19.35 timeframe?
  513.           (if (eq (device-type) 'win32)
  514.               nil
  515.             (cons "[Emacs]" 'w3-menu-toggle-menubar)))))
  516.           cons
  517.           (vec (vector 'rootmenu 'w3 nil))
  518.           ;; menus appear in the opposite order that we
  519.           ;; define-key them.
  520.           (menu-list 
  521.            (if (consp w3-use-menus)
  522.            (reverse w3-use-menus)
  523.          (list 'help nil 'emacs 'buffers 'options 'bookmark
  524.                'go 'view 'edit 'file))))
  525.       (while menu-list
  526.         (if (null (car menu-list))
  527.         nil;; no flushright support in FSF Emacs
  528.           (aset vec 2 (intern (concat "w3-menu-fsfemacs-"
  529.                       (symbol-name
  530.                        (car menu-list)) "-menu")))
  531.           (setq cons (assq (car menu-list) menu-alist))
  532.           (if cons
  533.           (define-key map vec (eval (car (cdr cons))))))
  534.         (setq menu-list (cdr menu-list))))
  535.     (setq w3-mode-menu-map map)
  536.     (run-hooks 'w3-menu-setup-hook))))
  537.  
  538. (defun w3-menu-make-xemacs-menubar ()
  539.   (let ((menu-alist
  540.      '((bookmark . w3-menu-bookmark-menu)
  541.        (style    . w3-menu-style-menu)
  542.        (buffers  . w3-menu-buffer-menu)
  543.        (debug    . w3-menu-debug-menu)
  544.        (edit     . w3-menu-edit-menu)
  545.        (emacs    . w3-menu-emacs-button)
  546.        (file     . w3-menu-file-menu)
  547.        (go       . w3-menu-go-menu)
  548.        (help     . w3-menu-help-menu)
  549.        (options  . w3-menu-options-menu)
  550.        (search   . w3-menu-search-menu)
  551.        (view     . w3-menu-view-menu)
  552.        )
  553.      )
  554.     cons
  555.     (menubar nil)
  556.     (menu-list w3-use-menus))
  557.     (while menu-list
  558.       (if (null (car menu-list))
  559.       (setq menubar (cons nil menubar))
  560.     (setq cons (assq (car menu-list) menu-alist))
  561.     (if cons
  562.         (setq menubar (cons (symbol-value (cdr cons)) menubar))))
  563.       (setq menu-list (cdr menu-list)))
  564.     (nreverse menubar)))
  565.  
  566. (defun w3-menu-install-menubar ()
  567.   (cond
  568.    (w3-running-xemacs
  569.     (cond
  570.      ((not (featurep 'menubar)) nil)    ; No menus available
  571.      ((featurep 'infodock) nil)        ; InfoDock does it automatically
  572.      (t
  573.       (setq w3-menu-w3-menubar (w3-menu-make-xemacs-menubar))
  574.       (set-buffer-menubar w3-menu-w3-menubar))))
  575.    ((not (fboundp 'w3-menu-fsfemacs-bookmark-menu))
  576.     (w3-menu-initialize-w3-mode-menu-map)
  577.     (define-key w3-mode-map [menu-bar]
  578.       (lookup-key w3-mode-menu-map [rootmenu w3])))))
  579.  
  580. (defun w3-menu-install-menubar-item ()
  581.   (cond
  582.    (w3-running-xemacs
  583.     (if (not (featurep 'menubar))
  584.     nil                ; No menus available
  585.       (set-buffer-menubar (copy-sequence (w3-menu-global-menubar)))
  586.       (add-menu nil "W3" (cdr w3-menu-w3-menubar))))
  587.    ((not (fboundp 'w3-menu-fsfemacs-edit-menu))
  588.     (w3-menu-initialize-w3-mode-menu-map)
  589.     (define-key w3-mode-map [menu-bar]
  590.       (lookup-key w3-mode-menu-map [rootmenu])))))
  591.  
  592. (defun w3-menu-install-menus ()
  593.   (cond ((= emacs-minor-version 28)    ; Hey, get with the times people!!
  594.      nil)
  595.     ((consp w3-use-menus)
  596.      (w3-menu-install-menubar))
  597.     ((eq w3-use-menus 1)
  598.      (w3-menu-install-menubar-item))
  599.     (t nil)))
  600.  
  601. (defun w3-menu-set-menubar-dirty-flag ()
  602.   (cond (w3-running-xemacs
  603.      (set-menubar-dirty-flag))
  604.     (t
  605.      (force-mode-line-update))))
  606.  
  607. (defun w3-menu-toggle-menubar ()
  608.   (interactive)
  609.   (cond
  610.    ;;((eq w3-use-menus 1)
  611.    ;;nil)
  612.    (w3-running-xemacs
  613.     (if (null (car (find-menu-item current-menubar '("XEmacs"))))
  614.     (set-buffer-menubar w3-menu-w3-menubar)
  615.       (set-buffer-menubar (copy-sequence (w3-menu-global-menubar)))
  616.       (condition-case ()
  617.       (add-menu-button nil ["W3" w3-menu-toggle-menubar t] nil)
  618.     (void-function
  619.      (add-menu-item nil "W3" 'w3-menu-toggle-menubar t))))
  620.     (w3-menu-set-menubar-dirty-flag))
  621.    (t
  622.     (if (not (eq (lookup-key w3-mode-map [menu-bar])
  623.          (lookup-key w3-mode-menu-map [rootmenu w3])))
  624.     (define-key w3-mode-map [menu-bar]
  625.       (lookup-key w3-mode-menu-map [rootmenu w3]))
  626.       (define-key w3-mode-map [menu-bar]
  627.     (make-sparse-keymap))
  628.       (define-key w3-mode-map [menu-bar w3]
  629.     (cons "[W3]" 'w3-menu-toggle-menubar)))
  630.     (w3-menu-set-menubar-dirty-flag))))
  631.  
  632. (defun w3-menu-save-options ()
  633.   (interactive)
  634.   (let ((output-buffer (find-file-noselect w3-default-configuration-file))
  635.     output-marker)
  636.     (save-excursion
  637.       (set-buffer output-buffer)
  638.       ;;
  639.       ;; Find and delete the previously saved data, and position to write.
  640.       ;;
  641.       (goto-char (point-min))
  642.       (if (re-search-forward "^;; W3 Options Settings *\n" nil 'move)
  643.       (let ((p (match-beginning 0)))
  644.         (goto-char p)
  645.         (or (re-search-forward
  646.          "^;; End of W3 Options Settings *\\(\n\\|\\'\\)"
  647.          nil t)
  648.         (error "can't find END of saved state in .emacs"))
  649.         (delete-region p (match-end 0)))
  650.     (goto-char (point-max))
  651.     (insert "\n"))
  652.       (setq output-marker (point-marker))
  653.       (let ((print-readably t)
  654.         (print-escape-newlines t)
  655.         (standard-output output-marker))
  656.     (princ ";; W3 Options Settings\n")
  657.     (princ ";; ===================\n")
  658.     (mapcar (function
  659.          (lambda (var)
  660.            (princ "  ")
  661.            (if (and (symbolp var) (boundp var))
  662.                (prin1 (list 'setq-default var
  663.                     (let ((val (symbol-value var)))
  664.                       (if (or (memq val '(t nil))
  665.                           (and (not (symbolp val))
  666.                            (not (listp val))))
  667.                       val
  668.                     (list 'quote val))))))
  669.            (if var (princ "\n"))))
  670.         '(
  671.           ps-print-color-p
  672.           url-automatic-caching
  673.           url-be-asynchronous
  674.           url-honor-refresh-requests
  675.           url-privacy-level
  676.           url-cookie-confirmation
  677.           url-proxy-services
  678.           url-standalone-mode
  679.           url-use-hypertext-gopher
  680.           w3-default-homepage
  681.           w3-default-stylesheet
  682.           w3-delay-image-loads
  683.           w3-do-incremental-display
  684.           w3-dump-to-disk
  685.           w3-honor-stylesheets
  686.           w3-image-mappings
  687.           w3-load-hook
  688.           w3-mode-hook
  689.           w3-netscape-compatible-comments
  690.           w3-preferences-cancel-hook
  691.           w3-preferences-default-hook
  692.           w3-preferences-ok-hook
  693.           w3-preferences-setup-hook
  694.           w3-source-file-hook
  695.           w3-toolbar-orientation
  696.           w3-toolbar-type
  697.           w3-use-menus
  698.           w3-user-colors-take-precedence
  699.           )
  700.         )
  701.     (princ ";; ==========================\n")
  702.     (princ ";; End of W3 Options Settings\n")))
  703.     (set-marker output-marker nil)
  704.     (save-excursion
  705.       (set-buffer output-buffer)
  706.       (save-buffer))
  707.     ))
  708.  
  709. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  710. ;;; Context-sensitive popup menu
  711. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  712. (if (not (fboundp 'event-glyph))
  713.     (fset 'event-glyph 'ignore))
  714.  
  715. (defun w3-popup-menu (e)
  716.   "Pop up a menu of common w3 commands"
  717.   (interactive "e")
  718.   (if (not w3-popup-menu-on-mouse-3)
  719.       (call-interactively (lookup-key global-map (vector w3-mouse-button3)))
  720.     (mouse-set-point e)
  721.     (let* ((glyph (event-glyph e))
  722.        (widget (or (and glyph (glyph-property glyph 'widget))
  723.                (widget-at (point))))
  724.        (parent (and widget (widget-get widget :parent)))
  725.        (href (or (and widget (widget-get widget :href))
  726.              (and parent (widget-get parent :href))))
  727.        (imag (or (and widget (widget-get widget :src))
  728.              (and parent (widget-get parent :src))))
  729.        (menu (copy-tree w3-popup-menu))
  730.        url val trunc-url)
  731.       (if href
  732.       (progn
  733.         (setq url href)
  734.         (if url (setq trunc-url (url-truncate-url-for-viewing
  735.                      url
  736.                      w3-max-menu-width)))
  737.         (setcdr menu (append (cdr menu)
  738.                  '("---")
  739.                  (mapcar
  740.                   (function
  741.                    (lambda (x)
  742.                      (vector (format (car x) trunc-url)
  743.                          (list (cdr x) url) t)))
  744.                   w3-hyperlink-menu)))))
  745.       (if imag
  746.       (progn
  747.         (setq url imag
  748.           trunc-url (url-truncate-url-for-viewing url
  749.                               w3-max-menu-width))
  750.         (setcdr menu (append (cdr menu)
  751.                  '("---")
  752.                  (mapcar
  753.                   (function
  754.                    (lambda (x)
  755.                      (vector (format (car x) trunc-url)
  756.                          (list (cdr x) url) t)))
  757.                   w3-graphlink-menu)))))
  758.       (if (not (w3-menubar-active))
  759.       (setcdr menu (append (cdr menu)
  760.                    '("---" ["Show Menubar" w3-toggle-menubar t]))))
  761.       (popup-menu menu))))
  762.  
  763. (provide 'w3-menu)
  764.